home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL2NO1.ARC / ANIMATE.LSP next >
Encoding:
Text File  |  1986-11-18  |  1.4 KB  |  37 lines
  1. ; --------------------------------------------------------
  2. ;
  3. ;   Setpath & Animate               Bill Kramer
  4. ;
  5. ;   Define a path (sequence of lines) for a block to
  6. ;   move along in "real time".
  7. ;
  8. (defun c:setpath ()
  9.    (prompt "Define a set of two or more points:")
  10.    (setq path-list nil)
  11.    (setq p1 (getpoint "\nStarting point:"))
  12.    (setq path-list (list p1))
  13.    (while (not (null (setq p1 (getpoint p1 "\nTo point:"))))
  14.           (setq path-list (cons p1 path-list)))
  15.    (setq path-list (reverse path-list))
  16.    (setq bname (car (entsel "\nSelect block to move:")))
  17.    (setq sdst (getdist "\nIncremental distance to move:")))
  18. (defun c:animate ()
  19.    (setq elist (entget bname))
  20.    (foreach pnt path-list
  21.         (setq elist (moveit elist pnt))))
  22. (defun moveit (elist topnt)
  23.    (setq dst (distance (cdr (assoc 10 elist)) topnt))
  24.    (setq ang (angle (cdr (assoc 10 elist)) topnt))
  25.    (setq dp (polar '(0 0) ang sdst))
  26.    (setq pdst 0.0)
  27.    (while (< (setq pdst (+ pdst sdst)) dst) 
  28.       (setq elist (entmod
  29.                      (subst
  30.                        (cons 10
  31.                          (mapcar '(lambda (a b) (+ a b))
  32.                                   (cdr (assoc 10 elist)) dp))
  33.                          (assoc 10 elist)
  34.                          elist))))
  35.     (entmod (subst (cons 10 topnt)
  36.                    (assoc 10 elist) elist)))
  37.